home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0071_Small UUE Encoder.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  2.2 KB  |  131 lines
  1. {$q-,r-,s-,d-,l-,y-,x-,v-,t-,n-,e-}
  2.  
  3. uses dos;
  4.  
  5. const
  6.   bytesperline=45;         { maximum bytes per encoded line }
  7.   masque6bits=$3f;        { mask for six lower bits }
  8.  
  9. procedure encodebuffer(var buf; len:word; var res:string); assembler ;
  10. asm
  11.   push ds
  12.   cld
  13.   lds si,buf
  14.   les di,res
  15.   mov cx,len
  16.   inc di
  17.   mov al,cl
  18.   add al,' '
  19.   stosb
  20.   mov dl,1
  21. @1:
  22.   lodsb
  23.   mov bl,al
  24.   shr al,2
  25.   add al,' '
  26.   stosb
  27.   shl bl,4
  28.   lodsb
  29.   mov bh,al
  30.   shr al,4
  31.   or  al,bl
  32.   and al,masque6bits
  33.   add al,' '
  34.   stosb
  35.   lodsb
  36.   mov bl,al
  37.   and bh,$0f
  38.   shl al,1
  39.   rcl bh,1
  40.   shl al,1
  41.   rcl bh,1
  42.   mov al,bh
  43.   add al,' '
  44.   stosb
  45.   mov al,bl
  46.   and al,masque6bits
  47.   add al,' '
  48.   stosb
  49.   add dl,4
  50.   sub cx,3
  51.   ja  @1
  52.   mov di,word ptr res
  53.   mov es:[di],dl
  54.   pop ds
  55. end;
  56.  
  57. procedure replacespacewithbackquote(var str:string); assembler;
  58. asm
  59.   les di,str
  60.   mov cl,es:[di]
  61.   xor ch,ch
  62.   cld
  63.   inc di
  64.   mov ax,'`'*256+' '
  65. @1:
  66.   jcxz @2
  67.   repne scasb
  68.   jne @2
  69.   mov es:[di-1],ah
  70.   jmp @1
  71. @2:
  72. end;
  73.  
  74. var
  75.   inbuf:array[1..100*bytesperline]of byte;
  76.   outbuf:array[1..8192] of char;
  77.  
  78. procedure encodefile(fname:string);
  79. var
  80.   inf:file;
  81.   outf:text;
  82.   outb:string[bytesperline*4 div 3+4];
  83.   lus:word;
  84.   inp:word;
  85.   nb:word;
  86.   rep:pathstr;
  87.   nom:namestr;
  88.   ext:extstr;
  89. begin
  90.   assign(inf,fname);
  91.   {$i-} reset(inf,1); {$i+}
  92.   if(ioresult<>0)then
  93.   begin
  94.     writeln('Can''t open ',fname);
  95.     exit;
  96.   end;
  97.   fsplit(fname,rep,nom,ext);
  98.   assign(outf,nom+'.uue');
  99.   rewrite(outf);
  100.   settextbuf(outf,outbuf,sizeof(outbuf));
  101.   writeln(outf,'begin 644 ',nom,ext);
  102.   while not eof(inf)do
  103.   begin
  104.     blockread(inf,inbuf,sizeof(inbuf),lus);
  105.     inp:=1;
  106.     if(lus<sizeof(inbuf))then
  107.     fillchar(inbuf[lus+1],sizeof(inbuf)-lus,0);
  108.     while(inp<=lus)do
  109.     begin
  110.       nb:=lus-inp+1;
  111.       if(nb>bytesperline)then nb:=bytesperline;
  112.       encodebuffer(inbuf[inp],nb,outb);
  113.       replacespacewithbackquote(outb);
  114.       writeln(outf,outb);
  115.       inc(inp,nb);
  116.     end;
  117.   end;
  118.   close(inf);
  119.   writeln(outf,'`');
  120.   writeln(outf,'end');
  121.   close(outf);
  122. end;
  123.  
  124. begin
  125.   if(paramcount<>1)then
  126.   begin
  127.     writeln('uue2 <file name>');
  128.     halt(1);
  129.   end;
  130.   encodefile(paramstr(1));
  131. end.